home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH11 / SRC / SEG3D.BAS < prev    next >
BASIC Source File  |  1995-11-30  |  5KB  |  163 lines
  1. Attribute VB_Name = "Seg3D"
  2. Option Explicit
  3.  
  4. Type Segment
  5.     ' The points to connect.
  6.     fr_pt(1 To 4) As Single
  7.     to_pt(1 To 4) As Single
  8.     
  9.     ' The transformed points to connect.
  10.     fr_tr(1 To 4) As Single
  11.     to_tr(1 To 4) As Single
  12. End Type
  13.  
  14. Type Transformation
  15.     M(1 To 4, 1 To 4) As Single
  16. End Type
  17.  
  18. Global NumSegments As Integer
  19. Global Segments() As Segment
  20.  
  21. ' ***********************************************
  22. ' Check that all of the segments in this object
  23. ' have the same length. Return true if the
  24. ' segments all have the same length.
  25. ' ***********************************************
  26. Public Function SameSideLengths(pt1 As Integer, pt2 As Integer) As Boolean
  27. Dim A As Single
  28. Dim B As Single
  29. Dim C As Single
  30. Dim S As Single
  31. Dim i As Integer
  32.  
  33.     A = Segments(pt1).fr_pt(1) - Segments(pt1).to_pt(1)
  34.     B = Segments(pt1).fr_pt(2) - Segments(pt1).to_pt(2)
  35.     C = Segments(pt1).fr_pt(3) - Segments(pt1).to_pt(3)
  36.     S = Sqr(A * A + B * B + C * C)
  37.     
  38.     SameSideLengths = False
  39.     For i = pt1 + 1 To pt2
  40.         A = Segments(i).fr_pt(1) - Segments(i).to_pt(1)
  41.         B = Segments(i).fr_pt(2) - Segments(i).to_pt(2)
  42.         C = Segments(i).fr_pt(3) - Segments(i).to_pt(3)
  43.         If Abs(S - Sqr(A * A + B * B + C * C)) > 0.001 Then Exit Function
  44.     Next i
  45.     
  46.     SameSideLengths = True
  47. End Function
  48.  
  49. ' ***********************************************
  50. ' Apply the translation matrix to all the
  51. ' segments using m3ApplyFull. The transformation
  52. ' may not have 0, 0, 0, 1 in its last column.
  53. ' ***********************************************
  54. Public Sub TransformAllDataFull(M() As Single)
  55.     TransformDataFull M, 1, NumSegments
  56. End Sub
  57.  
  58. ' ***********************************************
  59. ' Apply the translation matrix to the indicated
  60. ' segments using m3ApplyFull. The transformation
  61. ' may not have 0, 0, 0, 1 in its last column.
  62. ' ***********************************************
  63. Public Sub TransformDataFull(M() As Single, seg1 As Integer, seg2 As Integer)
  64. Dim i As Integer
  65.     
  66.     For i = seg1 To seg2
  67.         m3ApplyFull Segments(i).fr_pt, M, Segments(i).fr_tr
  68.         m3ApplyFull Segments(i).to_pt, M, Segments(i).to_tr
  69.     Next i
  70. End Sub
  71.  
  72.  
  73. ' ***********************************************
  74. ' Apply the translation matrix to all of the
  75. ' segments using m3Apply. This transformation
  76. ' must have 0, 0, 0, 1 in its last column.
  77. ' ***********************************************
  78. Public Sub TransformAllData(M() As Single)
  79.     TransformData M, 1, NumSegments
  80. End Sub
  81.  
  82.  
  83.  
  84.  
  85. ' ***********************************************
  86. ' Apply the translation matrix to all the
  87. ' indicated segments using m3Apply. This
  88. ' transformation must have 0, 0, 0, 1 in its last
  89. ' column.
  90. ' ***********************************************
  91. Public Sub TransformData(M() As Single, seg1 As Integer, seg2 As Integer)
  92. Dim i As Integer
  93.     
  94.     For i = seg1 To seg2
  95.         m3Apply Segments(i).fr_pt, M, Segments(i).fr_tr
  96.         m3Apply Segments(i).to_pt, M, Segments(i).to_tr
  97.     Next i
  98. End Sub
  99.  
  100. ' ***********************************************
  101. ' Set the point data to the transformed point data.
  102. ' ***********************************************
  103. Public Sub SetPoints(seg1 As Integer, seg2 As Integer)
  104. Dim i As Integer
  105. Dim j As Integer
  106.  
  107.     For i = seg1 To seg2
  108.         For j = 1 To 3
  109.             Segments(i).fr_pt(j) = Segments(i).fr_tr(j)
  110.             Segments(i).to_pt(j) = Segments(i).to_tr(j)
  111.         Next j
  112.     Next i
  113. End Sub
  114.  
  115. ' *******************************************************
  116. ' Draw the transformed segments.
  117. ' *******************************************************
  118. Public Sub DrawAllData(pic As Object, color As Long, clear As Boolean)
  119.     DrawSomeData pic, 1, NumSegments, color, clear
  120. End Sub
  121.  
  122. ' *******************************************************
  123. ' Draw the indicated transformed segments.
  124. ' *******************************************************
  125. Public Sub DrawSomeData(pic As Object, first_seg As Integer, last_seg As Integer, color As Long, clear As Boolean)
  126. Dim i As Integer
  127. Dim x1 As Single
  128. Dim y1 As Single
  129. Dim x2 As Single
  130. Dim y2 As Single
  131.  
  132.     If clear Then pic.Cls
  133.     
  134.     pic.ForeColor = color
  135.     For i = first_seg To last_seg
  136.         x1 = Segments(i).fr_tr(1)
  137.         y1 = Segments(i).fr_tr(2)
  138.         x2 = Segments(i).to_tr(1)
  139.         y2 = Segments(i).to_tr(2)
  140.         pic.Line (x1, y1)-(x2, y2)
  141.     Next i
  142. End Sub
  143.  
  144.  
  145. ' *******************************************************
  146. ' Create a segment.
  147. ' *******************************************************
  148. Public Sub MakeSegment(x1 As Single, y1 As Single, z1 As Single, x2 As Single, y2 As Single, z2 As Single)
  149.     NumSegments = NumSegments + 1
  150.     ReDim Preserve Segments(1 To NumSegments)
  151.     Segments(NumSegments).fr_pt(1) = x1
  152.     Segments(NumSegments).fr_pt(2) = y1
  153.     Segments(NumSegments).fr_pt(3) = z1
  154.     Segments(NumSegments).fr_pt(4) = 1
  155.     Segments(NumSegments).to_pt(1) = x2
  156.     Segments(NumSegments).to_pt(2) = y2
  157.     Segments(NumSegments).to_pt(3) = z2
  158.     Segments(NumSegments).to_pt(4) = 1
  159. End Sub
  160.  
  161.  
  162.  
  163.